home *** CD-ROM | disk | FTP | other *** search
/ Amiga Plus Special 21 / AMIGAplus Sonderheft 21 (1999)(ICP)(DE)[!].iso / Rexx / Catalog.pprx < prev    next >
Text File  |  1999-08-18  |  25KB  |  867 lines
  1. /* Personal Paint Amiga Rexx script - Copyright © 1996, 1997 Cloanto Italia srl */
  2.  
  3. /* $VER: Catalog.pprx 1.3 */
  4.  
  5. /** ENG
  6.  This script creates reference catalogs ("thumbnails") for the images
  7.  contained in the specified directory.
  8.  
  9.  The first requester can be used to select the catalog background
  10.  (white, gray, or black), the number of thumbnail columns (i.e. images
  11.  per row) and the temporary file directory used by the script. It is also
  12.  possible to decide whether an optimized palette should be generated for
  13.  each catalog (based on thumbnail colors) or not (the palette of the
  14.  current environment is used). The "Test Mode" option quickly shows
  15.  a sample catalog preview based on the current settings.
  16.  
  17.  The catalog format is based on the current image format (width, height,
  18.  aspect ratio and number of colors). This also affects the number of
  19.  catalog files generated.
  20.  
  21.  If not in test mode, two file requesters follow: the first one can be used
  22.  to select the source directory, the second one to select the destination
  23.  directory (where the catalog files will be saved), the root of the file
  24.  name and the file format/options. If the base name contains one or more
  25.  consecutive "0" characters, they will be used and progressively replaced
  26.  to store the catalog number (e.g. "Cat_000.pic" becomes "Cat_001.pic",
  27.  "Cat_002.pic", etc.).
  28.  
  29.  If a catalog file (matching the specified base name) already exists in
  30.  the destination directory, a message asks for confirmation before deleting
  31.  the old files.
  32.  
  33.  Several program settings affect the quality of the catalog images
  34.  generated by this script. These settings are: Color Reduction, Dithering,
  35.  Color Average Resize. For best-quality results, the
  36.  Floyd-Steinberg/Best Quality dithering should be selected, the
  37.  Color Average Resize option should be activated and an appropriate image
  38.  format should be used (the higher the number of colors, the better):
  39.  this is likely to slow down the generation of the catalog, but greatly
  40.  enhances the quality of the thumbnail catalogs.
  41. */
  42.  
  43. /** DEU
  44.  Dieses Skript ermöglicht die Erstellung eines Bilderkatalogs mit
  45.  verkleinerten Abbildungen der in einem Verzeichnis enthaltenen
  46.  Grafiken (sog. "Thumbnails").
  47.  
  48.  Im ersten Dialogfenster lassen sich Elemente wie der Seitenhintergrund
  49.  (wahlweise Weiß, Grau oder Schwarz), Spaltenanzahl (d. h.
  50.  die Anzahl der Bilder pro Zeile) und das temporäre Dateiverzeichnis für
  51.  das Skript festlegen. Es besteht darüber hinaus auch die Möglichkeit,
  52.  für jeden Katalog eine (auf der Palette der Kleingrafiken
  53.  basierende) Palette generieren zu lassen. Wird dies nicht gewünscht,
  54.  verwendet das Skript die Palette der aktuellen Arbeitsumgebung.
  55.  Mit Hilfe der Option "Testmodus" läßt sich eine
  56.  Katalogvorschau auf der Grundlage der aktuellen Einstellungen anzeigen.
  57.  
  58.  Das Format des Bilderkatalogs basiert grundsätzlich auf dem aktuellen
  59.  Bildformat (Breite, Höhe, Seitenverhältnis und Anzahl der Farben).
  60.  Auch die Anzahl der erzeugten Katalogdateien wird dadurch beeinflußt.
  61.  
  62.  Wenn Sie sich nicht im Testmodus befinden, werden noch zwei weitere
  63.  Dateiauswahlfenster geöffnet: Das erste dient zur Auswahl des Quell-,
  64.  und das zweite entsprechend zur Festlegung des Zielverzeichnisses
  65.  (dort werden die Katalogdateien gespeichert) sowie des Dateinamenstamms
  66.  und einiger Optionen bezüglich des Dateiformats. Wenn der Stamm des
  67.  Dateinamens eine oder mehrere aufeinanderfolgende Nullen "0" enthält,
  68.  werden diese zur Speicherung der Katalognummer verwendet. Beispiel:
  69.  "Katze_000.pic" wird zu "Katze_001.pic", "Katze_002.pic", usw.
  70.  
  71.  Ist im Zielverzeichnis bereits eine Katalogdatei mit dem angegebenen
  72.  Namensstamm vorhanden, so erscheint vor dem Überschreiben der alten
  73.  Dateien zunächst eine Sicherheitsabfrage.
  74.  
  75.  Die Qualität der für den Bilderkatalog erzeugten Kleingrafiken läßt sich
  76.  durch die folgenden Programmeinstellungen beeinflussen:
  77.  Farbreduzierung, Fehlerverteilung, "Farben mit Größe ändern".
  78.  Um ein optimales Ergebnis zu erzielen, sollte wie folgt vorgegangen
  79.  werden: Schalten Sie als Ditheringverfahren "Floyd-Steinberg" ein,
  80.  aktivieren Sie die Option "Farben mit Größe ändern", und verwenden Sie
  81.  ein geeignetes Bildformat, wobei gilt: Je mehr Farben, desto besser.
  82.  Dies erfordert zwar u. U. einen größeren Zeitaufwand, liefert aber eine
  83.  erheblich verbesserte Qualität der im Bilderkatalog enthaltenen Grafiken.
  84. */
  85.  
  86. /** ITA
  87.  Questo script crea cataloghi di riferimento ("miniature") delle immagini
  88.  presenti nel cassetto specificato.
  89.  
  90.  Si può usare la prima finestra di dialogo per scegliere lo sfondo del
  91.  catalogo (bianco, grigio o nero), il numero di colonne per le miniature
  92.  (numero di immagini per riga) e il cassetto temporaneo per file usato
  93.  dallo script. È anche possibile decidere se creare una tavolozza ottimizzata
  94.  per ciascun catalogo (in base ai colori delle miniature) o no (si utilizza
  95.  la tavolozza dell'ambiente corrente). L'opzione "Prova" visualizza in modo
  96.  rapido un'anteprima di esempio del catalogo in base alle impostazioni correnti.
  97.  
  98.  Il formato del catalogo si basa su quello dell'immagine corrente (larghezza,
  99.  altezza, aspetto e numero di colori). Ciò determina anche il numero di
  100.  file di catalogo generati.
  101.  
  102.  Se non si è in modo prova, si aprono due finestre per scelta file: la prima
  103.  si può usare per selezionare il cassetto di origine, la seconda per indicare
  104.  quello di destinazione (quello in cui saranno salvati i file dei cataloghi),
  105.  radice (parte costante) del nome file e formato/opzioni file. Se il nome di
  106.  base del file contiene uno o più caratteri "0" consecutivi, essi saranno usati
  107.  e progressivamente incrementati per immagazzinare il numero di riferimento
  108.  all'interno del catalogo (es. "Cat_000.pic" diventa "Cat_001.pic",
  109.  "Cat_002.pic", ecc.).
  110.  
  111.  Se nel cassetto di destinazione esiste già un file di catalogo (avente un
  112.  nome base coincidente con quello specificato), un messaggio chiederà conferma
  113.  prima della cancellazione dei vecchi file.
  114.  
  115.  Diverse impostazioni del programma influenzano la qualità delle immagini del
  116.  catalogo generate da questo script. Questi parametri sono: Riduzione colori,
  117.  Adattamento colori, Rimodellamento con media. Per avere i migliori risultati
  118.  in termini qualitativi, si dovrebbe attivare Floyd-Steinberg/Qualità ottimale,
  119.  Rimodellamento con media e usare un formato immagine appropriato (quanto più
  120.  sarà alto il numero di colori, tanto più sarà migliore il risultato); ciò
  121.  probabilmente rallenterà la creazione del catalogo, ma innalzerà di molto la
  122.  qualità dei cataloghi con immagini in miniatura.
  123. */
  124.  
  125. IF ARG(1, EXISTS) THEN
  126.     PARSE ARG PPPORT
  127. ELSE
  128.     PPPORT = 'PPAINT'
  129.  
  130. IF ~SHOW('P', PPPORT) THEN DO
  131.     IF EXISTS('PPaint:PPaint') THEN DO
  132.         ADDRESS COMMAND 'Run >NIL: PPaint:PPaint'
  133.         DO 30 WHILE ~SHOW('P',PPPORT)
  134.              ADDRESS COMMAND 'Wait >NIL: 1 SEC'
  135.         END
  136.     END
  137.     ELSE DO
  138.         SAY "Personal Paint could not be loaded."
  139.         EXIT 10
  140.     END
  141. END
  142.  
  143. IF ~SHOW('P', PPPORT) THEN DO
  144.     SAY 'Personal Paint Rexx port could not be opened'
  145.     EXIT 10
  146. END
  147.  
  148. ADDRESS VALUE PPPORT
  149. OPTIONS RESULTS
  150. OPTIONS FAILAT 10000
  151.  
  152. Get 'LANG'
  153. IF RESULT = 1 THEN DO        /* Deutsch */
  154.     txt_test_tname    = 'Test.pic'
  155.     txt_title_set     = 'Katalogeinstellungen'
  156.     txt_title_font    = 'Font auswählen'
  157.     txt_title_src     = 'Quellverzeichnis auswählen'
  158.     txt_title_dst     = 'Format und Namensstamm auswählen'
  159.     txt_title_del     = 'Achtung'
  160.     txt_gad_bkg       = '_Hintergrund:'
  161.     txt_gad_bkg0      = 'Weiß'
  162.     txt_gad_bkg1      = 'Grau'
  163.     txt_gad_bkg2      = 'Schwarz'
  164.     txt_gad_colmn     = '_Spalten:'
  165.     txt_gad_recurse   = '_Unterverzeichnisse:'
  166.     txt_gad_workdir   = 'Ar_beitsverzeichnis:'
  167.     txt_gad_makeplt   = '_Palette erzeugen:'
  168.     txt_gad_test      = '_Test:'
  169.     txt_gad_yes       = '_Ja'
  170.     txt_gad_no        = '_Nein'
  171.     txt_msg_del0      = 'Sollen bestehende Alben'
  172.     txt_msg_del1      = 'gelöscht werden?'
  173.     txt_err_oldclient = 'Für dieses Skript_ist eine neuere Version_von Personal Paint erforderlich'
  174.     txt_err_resize    = 'Fehler bei Größenberechnung: '
  175.     txt_err_load      = 'Fehler beim Laden: '
  176.     txt_err_save      = 'Fehler beim Speichern: '
  177.     txt_err_creduc    = 'Fehler bei Farbreduzierung: '
  178.     txt_err_cremap    = 'Fehler bei Farbneuberechnung: '
  179. END
  180. ELSE IF RESULT = 2 THEN DO    /* Italiano */
  181.     txt_test_tname    = 'Prova.pic'
  182.     txt_title_set     = 'Parametri catalogo'
  183.     txt_title_font    = 'Selezionare font'
  184.     txt_title_src     = 'Selezionare cassetto immagini'
  185.     txt_title_dst     = 'Selezionare nome e formato catalogo'
  186.     txt_title_del     = 'Attenzione'
  187.     txt_gad_bkg       = '_Sfondo:'
  188.     txt_gad_bkg0      = 'Bianco'
  189.     txt_gad_bkg1      = 'Grigio'
  190.     txt_gad_bkg2      = 'Nero'
  191.     txt_gad_colmn     = 'C_olonne:'
  192.     txt_gad_recurse   = "Tutti i _cassetti:"
  193.     txt_gad_workdir   = 'Cassetto di la_voro:'
  194.     txt_gad_makeplt   = 'Creare _tavolozza:'
  195.     txt_gad_test      = '_Prova:'
  196.     txt_gad_yes       = '_Sì'
  197.     txt_gad_no        = '_No'
  198.     txt_msg_del0      = 'I cataloghi esistenti'
  199.     txt_msg_del1      = 'devono essere cancellati?'
  200.     txt_err_oldclient = 'Questa procedura richiede_una versione più recente_di Personal Paint'
  201.     txt_err_resize    = 'Errore nel ridimensionamento: '
  202.     txt_err_load      = 'Errore nella lettura: '
  203.     txt_err_save      = 'Errore nella scrittura: '
  204.     txt_err_creduc    = 'Errore nella riduzione colori: '
  205.     txt_err_cremap    = 'Errore nell''adattamento colori: '
  206. END
  207. ELSE DO                /* English */
  208.     txt_test_tname    = 'Test.pic'
  209.     txt_title_set     = 'Catalog Settings'
  210.     txt_title_font    = 'Select Font'
  211.     txt_title_src     = 'Select Source Directory'
  212.     txt_title_dst     = 'Select Format and Root Name'
  213.     txt_title_del     = 'Attention'
  214.     txt_gad_bkg       = '_Background:'
  215.     txt_gad_bkg0      = 'White'
  216.     txt_gad_bkg1      = 'Gray'
  217.     txt_gad_bkg2      = 'Black'
  218.     txt_gad_colmn     = 'C_olumns:'
  219.     txt_gad_recurse   = '_Subdirectories:'
  220.     txt_gad_workdir   = '_Work Directory:'
  221.     txt_gad_makeplt   = '_Make Palette:'
  222.     txt_gad_test      = '_Test:'
  223.     txt_gad_yes       = '_Yes'
  224.     txt_gad_no        = '_No'
  225.     txt_msg_del0      = 'Should existing catalog files'
  226.     txt_msg_del1      = 'be deleted?'
  227.     txt_err_oldclient = 'This script requires a newer_version of Personal Paint'
  228.     txt_err_resize    = 'Error during resize: '
  229.     txt_err_load      = 'Error during load: '
  230.     txt_err_save      = 'Error during save: '
  231.     txt_err_creduc    = 'Color reduction error: '
  232.     txt_err_cremap    = 'Color remap error: '
  233. END
  234.  
  235. Version 'REXX'
  236. IF RESULT < 7 THEN DO
  237.     RequestNotify 'PROMPT "'txt_err_oldclient'"'
  238.     EXIT 10
  239. END
  240.  
  241. srcdir      = LoadSet('SourceDir',  'PPaint:Pictures', 0)
  242. dstdir      = LoadSet('DestDir',    'PPaint:Pictures', 0)
  243. dstfile     = LoadSet('DestFile',   '000_Catalog.pic', 0)
  244. dstformat   = LoadSet('DestFormat', '', 0)
  245. fontpath    = LoadSet('FontPath',   'FONTS:', 0)
  246. fontname    = LoadSet('FontName',   'CGTriumvirate', 0)
  247. fontsize    = LoadSet('FontSize',    12, 0)
  248. fontstyle   = LoadSet('FontStyle',   's', 0)
  249. backgr      = LoadSet('Background',  0)
  250. columns     = LoadSet('Columns',     5)
  251. makepalette = LoadSet('MakePalette', 1)
  252. recurse     = LoadSet('Recurse',     0)
  253. tempdir     = LoadSet('TempDir',     'T:')
  254. test        = LoadSet('Test',        0)
  255.  
  256. max_tempdir_size = 80
  257.  
  258. FreeEnvironment 'QUERY'
  259. IF RC ~= 0 THEN
  260.     EXIT RC
  261. FreeBrush
  262. IF RC ~= 0 THEN
  263.     EXIT RC
  264.  
  265. Request '"'txt_title_set'" ' ||,
  266.             '"CYCLE = ""'txt_gad_bkg'"", 3, 'backgr', ""'txt_gad_bkg0'"", ""'txt_gad_bkg1'"", ""'txt_gad_bkg2'"" ' ||,
  267.             ' INTSTR = ""'txt_gad_colmn'"", 1, 32767, 'columns' ' ||,
  268.             ' STRING = ""'txt_gad_workdir'"", 'max_tempdir_size', ""'tempdir'"" ' ||,
  269.             ' CHECK = ""'txt_gad_makeplt'"", 'makepalette' ' ||,
  270.             ' CHECK = ""'txt_gad_recurse'"", 'recurse' ' ||,
  271.             ' CHECK = ""'txt_gad_test'"", 'test' "'
  272. IF RC ~= 0 THEN
  273.     EXIT RC
  274. backgr  = RESULT.1
  275. columns = RESULT.2
  276. tempdir = RESULT.3
  277. makepalette = RESULT.4
  278. recurse = RESULT.5
  279. test    = RESULT.6
  280.  
  281. delete_old = 0
  282.  
  283. RequestFont '"'txt_title_font'" PATH "'fontpath'" NAME "'fontname'" SIZE "'fontsize'" STYLE "'fontstyle'"'
  284. IF RC ~= 0 THEN
  285.     EXIT RC
  286. PARSE VALUE RESULT WITH '"' fontpath '" "' fontname '"' fontsize fontstyle
  287.  
  288. IF ~test THEN DO
  289.     RequestPath '"'txt_title_src'" PATH "'srcdir'"'
  290.     IF RC ~= 0 THEN
  291.         EXIT RC
  292.     PARSE VALUE RESULT WITH '"' srcdir '"'
  293.  
  294.     RequestFile 'TITLE "'txt_title_dst'" PATH "'dstdir'" FILE "'dstfile'" SAVEMODE LISTFORMATS FORCE' dstformat
  295.     IF RC ~= 0 THEN
  296.         EXIT RC
  297.     PARSE VALUE RESULT WITH '"' dstdfile '"' dstformat
  298.     ppos = MAX(LASTPOS(':', dstdfile), LASTPOS('/', dstdfile)) + 1
  299.     dstdir = LEFT(dstdfile, ppos-1)
  300.     dstfile = SUBSTR(dstdfile, ppos)
  301.  
  302.     IF RIGHT(dstdir, 1) = '/' THEN
  303.         dst = LEFT(dstdfile, ppos-2)
  304.     ELSE
  305.         dst = dstdir
  306.     same_srcdst = (dst == srcdir)
  307.  
  308.     tmpfname = 'T:pprx_cat.'PRAGMA('ID')
  309.     destpattern = CatalogFName(dstfile, 0, 1)
  310.  
  311.     LockGUI
  312.     IF recurse & same_srcdst THEN
  313.         ADDRESS COMMAND 'List >'tmpfname' "'srcdir'" NOHEAD PAT="'destpattern'" LFORMAT="%s%s" FILES ALL'
  314.     ELSE
  315.         ADDRESS COMMAND 'List >'tmpfname' "'dstdir'" NOHEAD PAT="'destpattern'" LFORMAT="%s%s" FILES'
  316.     UnlockGUI
  317.  
  318.     oldfiles = 0
  319.     IF OPEN('listfile', tmpfname, 'R') THEN DO
  320.         IF LENGTH(READLN('listfile')) > 0 THEN
  321.             oldfiles = 1
  322.         CALL CLOSE('listfile')
  323.     END
  324.     ADDRESS COMMAND 'Delete >NIL: 'tmpfname
  325.     IF oldfiles THEN DO
  326.         Request '"'txt_title_del'" ' ||,
  327.                     '"TEXT = ""'txt_msg_del0'"" ' ||,
  328.                     ' TEXT = ""'txt_msg_del1'"" ' ||,
  329.                     ' ACTION = ""'txt_gad_yes'"" ACTION = ""'txt_gad_no'"" ACTION = CANCEL"'
  330.         IF RC ~= 0 THEN
  331.             EXIT RC
  332.         IF RESULT = 1 THEN
  333.             delete_old = 1
  334.     END
  335. END
  336.  
  337.  
  338.  
  339. LockGUI
  340.  
  341. CALL SaveSet('SourceDir',   srcdir)
  342. CALL SaveSet('DestDir',     dstdir)
  343. CALL SaveSet('DestFile',    dstfile)
  344. CALL SaveSet('DestFormat',  dstformat)
  345. CALL SaveSet('FontPath',    fontpath)
  346. CALL SaveSet('FontName',    fontname)
  347. CALL SaveSet('FontSize',    fontsize)
  348. CALL SaveSet('FontStyle',   fontstyle)
  349. CALL SaveSet('Background',  backgr)
  350. CALL SaveSet('Columns',     columns)
  351. CALL SaveSet('MakePalette', makepalette)
  352. CALL SaveSet('Recurse',     recurse)
  353. CALL SaveSet('TempDir',     tempdir)
  354. CALL SaveSet('Test',        test)
  355.  
  356.  
  357.  
  358. Get 'COLORS'
  359. cnum = RESULT
  360. Get 'IMAGEW'
  361. imgwidth = RESULT
  362. Get 'IMAGEH'
  363. imgheight = RESULT
  364. GetImageAttributes 'DPIX'
  365. hdpi = RESULT
  366. GetImageAttributes 'DPIY'
  367. imgratio = hdpi / RESULT
  368. Get 'CAVRESIZE'
  369. cavrg = RESULT
  370.  
  371. hgap  = TRUNC((imgwidth / columns) / 6)
  372. tilew = TRUNC((imgwidth - (hgap * (columns + 1))) / columns)
  373. hgap  = TRUNC((imgwidth - (tilew * columns)) / (columns + 1))
  374. vgap  = hgap % imgratio
  375. tileh = tilew % imgratio
  376. txgap = vgap % 10
  377.  
  378. htgap = imgwidth % 100
  379. thmbw = tilew - (htgap * 2)
  380. vtgap = htgap % imgratio
  381. thmbh = tileh - (vtgap * 2)
  382.  
  383. CALL FindPens
  384.  
  385. GetArea
  386. areasets = RESULT
  387. SetArea 'FILLSOLID'
  388. tmpfname = ''
  389. tmpdname = ''
  390.  
  391. Get 'GCLIP'
  392. saveclip = RESULT
  393. Set '"GCLIP=0"'
  394.  
  395. SIGNAL ON Break_C
  396.  
  397. IF test THEN DO
  398.     CALL InitPage
  399.     brushw = thmbw
  400.     brushh = (thmbh % 3) * 2
  401.     brushname = txt_test_tname
  402.     DO UNTIL AddTile(0)
  403.     END
  404.     CALL Break_C
  405.     EXIT 0
  406. END
  407.  
  408. dir_trail = RIGHT(tempdir, 1)
  409. IF dir_trail ~= ':' & dir_trail ~= '/' THEN
  410.     tempdir = tempdir || '/'
  411. tempdir = tempdir || PRAGMA('ID')
  412. ADDRESS COMMAND 'MakeDir >NIL: "'tempdir'"'
  413. IF RC ~= 0 THEN
  414.     EXIT RC
  415. tempdir = tempdir || '/'
  416.  
  417. tmpdname = 'T:pprx_dcat.'PRAGMA('ID')
  418. tmpfname = 'T:pprx_cat.'PRAGMA('ID')
  419. tmpfname2 = tmpfname || '.2'
  420.  
  421. IF OPEN('listfile', tmpdname, 'W') THEN DO
  422.     CALL WRITELN('listfile', srcdir)
  423.     CALL CLOSE('listfile')
  424. END
  425. IF recurse THEN
  426.     ADDRESS COMMAND 'List >>'tmpdname' "'srcdir'" NOHEAD LFORMAT="%s%s" DIRS ALL'
  427.  
  428. IF OPEN('dirlistfile', tmpdname, 'R') THEN DO
  429.     cancelled = 0
  430.     catnum = 1
  431.     DO FOREVER
  432.         srcdir = READLN('dirlistfile')
  433.         IF EOF('dirlistfile') THEN
  434.             LEAVE
  435.  
  436.         IF recurse & same_srcdst THEN DO
  437.             dstdir = srcdir
  438.             dir_trail = RIGHT(dstdir, 1)
  439.             IF dir_trail ~= ':' & dir_trail ~= '/' THEN
  440.                 dstdir = dstdir || '/'
  441.         END
  442.  
  443.         IF delete_old THEN DO
  444.             dir_trail = RIGHT(dstdir, 1)
  445.             IF dir_trail ~= ':' & dir_trail ~= '/' THEN
  446.                 deldir = dstdir || '/'
  447.             ELSE
  448.                 deldir = dstdir
  449.             ADDRESS COMMAND 'Delete >NIL: "'deldir || destpattern'"'
  450.             ADDRESS COMMAND 'Delete >NIL: "'deldir || destpattern'.info"'
  451.         END
  452.  
  453.         ADDRESS COMMAND 'List >'tmpfname' "'srcdir'" NOHEAD PAT=~(#?.info) LFORMAT="%s%s" FILES'
  454.         IF RC = 0 THEN DO
  455.             ADDRESS COMMAND 'Sort 'tmpfname tmpfname'.s'
  456.             IF RC = 0 THEN DO
  457.                 ADDRESS COMMAND 'Delete >NIL: 'tmpfname
  458.                 tmpfname = tmpfname'.s'
  459.             END
  460.         END
  461.  
  462.         IF OPEN('listfile', tmpfname, 'R') THEN DO
  463.             errmess = ''
  464.             done = 0
  465.             IF (~recurse) | same_srcdst THEN
  466.                 catnum = 1
  467.  
  468.             DO UNTIL done
  469.                 CALL InitPage
  470.                 thmbcolors = ''
  471.                 gottn = 0
  472.                 DO FOREVER
  473.                     fname = READLN('listfile')
  474.                     IF EOF('listfile') THEN DO
  475.                         done = 1
  476.                         LEAVE
  477.                     END
  478.                     LoadBrush '"'fname'" QUIET FORCE NOPROGRESS'
  479.                     IF RC = 0 THEN DO
  480.                         GetBrushAttributes 'WIDTH'
  481.                         bw = RESULT
  482.                         GetBrushAttributes 'HEIGHT'
  483.                         bh = RESULT
  484.                         GetBrushAttributes 'DPIX'
  485.                         bhdpi = RESULT
  486.                         GetBrushAttributes 'DPIY'
  487.                         bvdpi = RESULT
  488.                         bratio = bhdpi / bvdpi
  489.  
  490.                         brushw = thmbw;
  491.                         brushh = TRUNC(((brushw / (bw / bh)) * bratio) / imgratio)
  492.                         IF brushh > thmbh THEN DO
  493.                             brushh = thmbh;
  494.                             brushw = TRUNC(((brushh / (bh / bw)) / bratio) * imgratio)
  495.                         END
  496.  
  497.                         IF cavrg = 0 THEN
  498.                             SetBrushAttributes 'WIDTH 'brushw' HEIGHT 'brushh' NOPROGRESS'
  499.                         ELSE
  500.                             SetBrushAttributes 'WIDTH 'brushw' HEIGHT 'brushh' COLORS 256 EXTENDPALETTE NOPROGRESS'
  501.                         IF RC = 0 THEN DO
  502.                             IF makepalette THEN DO
  503.                                 BrushColorStatistics 'COLORS COMPACT NOPROGRESS'
  504.                                 IF RC = 0 THEN DO
  505.                                     thcolors = RESULT
  506.                                     IF (LENGTH(thmbcolors) + LENGTH(thcolors)) < 65535 THEN
  507.                                         thmbcolors = thmbcolors thcolors
  508.                                 END
  509.                             END
  510.                             ppos = MAX(LASTPOS(':', fname), LASTPOS('/', fname)) + 1
  511.                             brushname = SUBSTR(fname, ppos)
  512.  
  513.                             SaveBrush '"'tempdir || brushname'" QUIET FORCE NOPROGRESS'
  514.                             IF RC = 0 THEN DO
  515.                                 gottn = 1
  516.                                 IF AddTile(0) THEN
  517.                                     LEAVE
  518.                             END
  519.                             ELSE DO
  520.                                 done = 1
  521.                                 errmess = txt_err_resize || RC
  522.                                 LEAVE
  523.                             END
  524.                         END
  525.                     END
  526.                     ELSE DO
  527.                         IF RC ~= 38 THEN DO    /* unrecognized format? */
  528.                             done = 1
  529.                             errmess = txt_err_load || RC
  530.                             LEAVE
  531.                         END
  532.                     END
  533.                 END
  534.  
  535.                 IF errmess ~= '' | gottn = 0 THEN
  536.                     LEAVE
  537.  
  538.                 IF makepalette THEN DO
  539.                     ReduceColors cnum '"'thmbcolors'"'
  540.                     IF RC ~= 0 THEN DO
  541.                         done = 1
  542.                         IF RC = 5 THEN
  543.                             cancelled = 1
  544.                         ELSE
  545.                             errmess = txt_err_creduc || RC
  546.                         LEAVE
  547.                     END
  548.                 END
  549.                 ELSE RC = 0
  550.  
  551.                 IF RC = 0 THEN DO
  552.                     IF makepalette THEN DO
  553.                         SetColors 'COLORS "'RESULT'"'
  554.                         CALL FindPens
  555.                     END
  556.  
  557.                     tmpfname2 = tmpfname || '.2'
  558.                     ADDRESS COMMAND 'List >'tmpfname2' "'tempdir'" NOHEAD PAT=~(#?.info) LFORMAT="%s%s" FILES'
  559.                     IF RC = 0 THEN DO
  560.                         ADDRESS COMMAND 'Sort 'tmpfname2 tmpfname2'.s'
  561.                         IF RC = 0 THEN DO
  562.                             ADDRESS COMMAND 'Delete >NIL: 'tmpfname2
  563.                             tmpfname2 = tmpfname2'.s'
  564.                         END
  565.                     END
  566.                     IF OPEN('listfile2', tmpfname2, 'R') THEN DO
  567.                         CALL InitPage
  568.  
  569.                         DO FOREVER
  570.                             fname = READLN('listfile2')
  571.                             IF EOF('listfile2') THEN
  572.                                 LEAVE
  573.                             LoadBrush '"'fname'" QUIET FORCE NOPROGRESS'
  574.                             IF RC = 0 THEN DO
  575.                                 GetBrushAttributes 'WIDTH'
  576.                                 brushw = RESULT
  577.                                 GetBrushAttributes 'HEIGHT'
  578.                                 brushh = RESULT
  579.  
  580.                                 RemapBrush 'NOPROGRESS'
  581.                                 IF RC = 0 THEN DO
  582.                                     ppos = MAX(LASTPOS(':', fname), LASTPOS('/', fname)) + 1
  583.                                     brushname = SUBSTR(fname, ppos)
  584.                                     IF AddTile(1) THEN
  585.                                         LEAVE
  586.                                 END
  587.                                 ELSE DO
  588.                                     done = 1
  589.                                     errmess = txt_err_cremap || RC
  590.                                     LEAVE
  591.                                 END
  592.                             END
  593.                             ELSE DO
  594.                                 done = 1
  595.                                 errmess = txt_err_load || RC
  596.                                 LEAVE
  597.                             END
  598.                         END
  599.                         CALL CLOSE('listfile2')
  600.  
  601.                         SaveImage '"'dstdir || CatalogFName(dstfile, catnum)'" FORCE QUIET' dstformat
  602.                         IF RC ~= 0 THEN DO
  603.                             done = 1
  604.                             IF RC = 5 THEN
  605.                                 cancelled = 1
  606.                             ELSE
  607.                                 errmess = txt_err_save || RC
  608.                         END
  609.                         catnum = catnum + 1
  610.                     END
  611.                     ADDRESS COMMAND 'Delete >NIL: 'tmpfname2
  612.                 END
  613.                 ADDRESS COMMAND 'Delete >NIL: "'tempdir'#?" QUIET'
  614.             END
  615.             CALL CLOSE('listfile')
  616.         END
  617.         IF errmess ~= '' THEN DO
  618.             RequestNotify 'PROMPT "'errmess'"'
  619.             LEAVE
  620.         END
  621.         IF cancelled THEN
  622.             LEAVE
  623.     END
  624.     CALL CLOSE('dirlistfile')
  625. END
  626.  
  627. CALL Break_C
  628.  
  629. EXIT 0
  630.  
  631.  
  632.  
  633.  
  634. InitPage:
  635.  
  636.     SetPen 'BACKGROUND 'colbackg
  637.     ClearImage
  638.  
  639.     clmn = 1
  640.     ypos = vgap
  641.     xpos = hgap
  642.  
  643.     RETURN
  644.  
  645.  
  646.  
  647.  
  648. FindPens:
  649.  
  650.     penpass = 0
  651.  
  652.     DO FOREVER
  653.         IF backgr = 0 THEN
  654.             FindColor '"255 255 255"'
  655.         ELSE IF backgr = 1 THEN
  656.             FindColor '"213 213 213"'
  657.         ELSE
  658.             FindColor '"0 0 0"'
  659.         colbackg = RESULT
  660.  
  661.         IF penpass = 0 THEN
  662.             FindColor '"213 213 213"'
  663.         ELSE
  664.             FindColor '"213 213 213" EXCLUDE "'colbackg'"'
  665.         coltile = RESULT
  666.  
  667.         IF backgr = 2 THEN
  668.             FindColor '"255 255 255"'
  669.         ELSE
  670.             FindColor '"0 0 0"'
  671.         coltext = RESULT
  672.  
  673.         FindColor '"0 0 0"'
  674.         colblack = RESULT
  675.         FindColor '"68 68 68"'
  676.         coldark1 = RESULT
  677.         FindColor '"140 140 140"'
  678.         coldark2 = RESULT
  679.         FindColor '"255 255 255"'
  680.         collight1 = colbackg
  681.         FindColor '"240 240 240"'
  682.         collight2 = RESULT
  683.  
  684.         penpass = penpass + 1
  685.         IF penpass > 1 THEN
  686.             LEAVE
  687.         IF collight1 ~= coltile & coldark1 ~= coltile THEN
  688.             LEAVE
  689.     END
  690.  
  691.     RETURN
  692.  
  693.  
  694.  
  695.  
  696. CatalogFName:
  697.     basefname = ARG(1)
  698.     catlgnum  = ARG(2)
  699.     IF ARG() > 2 THEN
  700.         pattern_fname = ARG(3)
  701.     ELSE
  702.         pattern_fname = 0
  703.  
  704.     npos1 = INDEX(basefname, '0')
  705.     IF npos1 = 0 THEN DO
  706.         IF pattern_fname THEN
  707.             RETURN basefname || '.???'
  708.         ELSE
  709.             RETURN basefname || '.' || RIGHT(catlgnum, 3, "0")
  710.     END
  711.  
  712.     ndigits = 1
  713.     bfnlen = LENGTH(basefname)
  714.     DO npos = npos1 + 1 TO bfnlen
  715.         IF SUBSTR(basefname, npos, 1) = '0' THEN
  716.             ndigits = ndigits + 1
  717.         ELSE
  718.             LEAVE
  719.     END
  720.     IF pattern_fname THEN
  721.         catgfname = LEFT(basefname, npos1 - 1) || '#?' || SUBSTR(basefname, npos)
  722.     ELSE
  723.         catgfname = LEFT(basefname, npos1 - 1) || RIGHT(catlgnum, ndigits, "0") || SUBSTR(basefname, npos)
  724.  
  725.     RETURN catgfname
  726.  
  727.  
  728.  
  729. AddTile:
  730.     with_brush = ARG(1)
  731.  
  732.     SetPen 'FOREGROUND 'coltile
  733.     DrawRectangle xpos ypos xpos+tilew-1 ypos+tileh-1 'FILL'
  734.  
  735.     xp0 = xpos + htgap + ((thmbw - brushw) % 2)
  736.     yp0 = ypos + vtgap + ((thmbh - brushh) % 2)
  737.  
  738.     IF collight1 ~= coltile & coldark1 ~= coltile THEN DO
  739.         xp1 = xp0 + brushw - 1
  740.         yp1 = yp0 + brushh - 1
  741.         xps1 = xpos + tilew - 1
  742.         yps1 = ypos + tileh - 1
  743.  
  744.         SetPen 'FOREGROUND 'collight1
  745.         DrawRectangle xp0    yp1+1  xp1+1   yp1+1 'FILL'
  746.         DrawRectangle xp1+1  yp1+1  xp1+1   yp0-1 'FILL'
  747.         DrawRectangle xpos    yps1  xpos    ypos  'FILL'
  748.         DrawRectangle xpos    ypos  xps1-1  ypos  'FILL'
  749.         SetPen 'FOREGROUND 'coldark1
  750.         DrawRectangle xp0-1  yp1+1  xp0-1   yp0-1 'FILL'
  751.         DrawRectangle xp0-1  yp0-1  xp1     yp0-1 'FILL'
  752.         DrawRectangle xpos+1  yps1  xps1    yps1  'FILL'
  753.         DrawRectangle xps1    yps1  xps1    ypos  'FILL'
  754.  
  755.         IF collight1 ~= collight2 & coldark1 ~= coldark2 THEN DO
  756.             SetPen 'FOREGROUND 'collight2
  757.             DrawRectangle xp0-1    yp1+2  xp1+2   yp1+2  'FILL'
  758.             DrawRectangle xp1+2    yp1+2  xp1+2   yp0-2  'FILL'
  759.             DrawRectangle xpos+1  yps1-1  xpos+1  ypos+1 'FILL'
  760.             DrawRectangle xpos+1  ypos+1  xps1-2  ypos+1 'FILL'
  761.             SetPen 'FOREGROUND 'coldark2
  762.             DrawRectangle xp0-2    yp1+2  xp0-2   yp0-2  'FILL'
  763.             DrawRectangle xp0-2    yp0-2  xp1+1   yp0-2  'FILL'
  764.             DrawRectangle xpos+2  yps1-1  xps1-1  yps1-1 'FILL'
  765.             DrawRectangle xps1-1  yps1-1  xps1-1  ypos+1 'FILL'
  766.         END
  767.     END
  768.  
  769.     IF with_brush THEN DO
  770.         SetPaintMode 'REPLACE'
  771.         SetBrushHandle 'UPPERLEFT'
  772.         PutBrush xp0 yp0
  773.     END
  774.     ELSE DO
  775.         SetPen 'FOREGROUND 'colblack
  776.         DrawRectangle xp0 yp0 xp0+brushw-1 yp0+brushh-1 'FILL'
  777.     END
  778.  
  779.     textyp = ypos + tileh + txgap
  780.     textx0 = xpos - hgap
  781.     textx1 = xpos + tilew + hgap - 1
  782.     SetPen 'FOREGROUND 'coltext
  783.     VectorText 'TEXT "'brushname'" FONTPATH "'fontpath'" FONTNAME "'fontname'" X0 'textx0' Y0 'textyp' X1 'textx1' Y1' (textyp + fontsize - 1) 'CENTER ANTIALIAS 2 KEEPRATIO KEEPBASELINE'
  784.     IF RC ~= 0 THEN
  785.         Text 'TEXT "'brushname'" FONTPATH "'fontpath'" FONTNAME "'fontname'" FONTSIZE 'fontsize' FONTSTYLE "'fontstyle'" X' (xpos + (tilew % 2)) ' Y 'textyp' CENTER'
  786.  
  787.     last_one = 0
  788.     xpos = xpos + tilew + hgap
  789.     clmn = clmn + 1
  790.     IF clmn > columns THEN DO
  791.         clmn = 1
  792.         xpos = hgap
  793.         totvgap = tileh + txgap + fontsize + (vgap % 3)
  794.         ypos = ypos + totvgap
  795.         IF (ypos + totvgap) > imgheight THEN
  796.             last_one = 1
  797.     END
  798.  
  799.     RETURN last_one
  800.  
  801.  
  802.  
  803.  
  804. SaveSet:
  805.     sname = ARG(1)
  806.     val = ARG(2)
  807.  
  808.     IF OPEN('settingfile', 'ENV:PP_Catal_'sname, 'W') THEN DO
  809.         CALL WRITECH('settingfile', val)
  810.         CALL CLOSE('settingfile')
  811.     END
  812.  
  813.     RETURN
  814.  
  815.  
  816.  
  817.  
  818. LoadSet:
  819.     sname = ARG(1)
  820.     def_val = ARG(2)
  821.     IF ARG() > 2 THEN
  822.         request_quote = ARG(3)
  823.     ELSE
  824.         request_quote = 1
  825.  
  826.     val = def_val
  827.     set_fname = 'ENV:PP_Catal_'sname
  828.  
  829.     IF OPEN('settingfile', set_fname, 'R') THEN DO
  830.         val = READCH('settingfile', 65535)
  831.         CALL CLOSE('settingfile')
  832.     END
  833.  
  834.     IF request_quote THEN DO
  835.         /* encode quotes for the Request command ('"' -> '\""') */
  836.         qpos_start = 1
  837.         DO FOREVER
  838.             qpos = INDEX(val, '"', qpos_start)
  839.             IF qpos = 0 THEN BREAK
  840.             val = INSERT('\"', val, qpos-1)
  841.             qpos_start = qpos + 3
  842.         END
  843.     END
  844.  
  845.     RETURN val
  846.  
  847.  
  848.  
  849.  
  850.  
  851. Break_C:
  852.  
  853.     IF tmpfname ~= '' THEN DO
  854.         ADDRESS COMMAND 'Delete >NIL: "'tempdir'" ALL QUIET'
  855.         ADDRESS COMMAND 'Delete >NIL: 'tmpfname tmpfname2
  856.     END
  857.     IF tmpdname ~= '' THEN
  858.         ADDRESS COMMAND 'Delete >NIL: 'tmpdname
  859.  
  860.     FreeBrush 'FORCE'
  861.     SelectSquareBrush 1
  862.     SetArea areasets
  863.     Set '"GCLIP='saveclip'"'
  864.     UnlockGUI
  865.  
  866.     RETURN 1
  867.